home *** CD-ROM | disk | FTP | other *** search
/ Informática Multimedia 1995 April / Informatica Multimedia CD - Epimundo.iso / DOS / FILECOPY / CLNUP.ZIP / CLEANUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-09-29  |  9.0 KB  |  252 lines
  1. (**************************************************************************
  2. PROGRAM NAME: CLEANUP.EXE
  3.  
  4. PURPOSE: Finds all drives and deletes any BAK, $$$, TMP, SYD or OLD files
  5.          it finds. Also deletes files with file length of zero.
  6.  
  7. DATE CREATED: 9 MAY 1993
  8. AUTHOR: Brian D. Catlin
  9.  
  10. COPYRIGHTS  This Program uses Libraries from Turbo Pascal 6.0,
  11.   AND       CopyRight 1983, 1990 by Borland International, Inc.
  12. TRADEMARKS  Turbo Pascal is a trademark of Borland International, Inc.
  13.             CompuServe is a trademark of CompuServe Inc.
  14.             Other Libraries used are from the disk supplied with
  15.             the book "PC Magazine Turbo PASCAL 6.0 Techniques And Utilities",
  16.             Copywrite 1991, by Ziff-Davis Press, and was authored by
  17.             Neil J. Rubenking.
  18.  
  19.             This program is Copywrite 1993, by Brian D. Catlin. The author
  20.             of this program shall not in any case be liable for any damages
  21.             incurred with the use of this program. There are no explicit or
  22.             implied warranties for this program.
  23.  
  24.             Released under the 'Stone Soup' Principle. If you make further
  25.             enhancements to this program, please send me a copy of the source
  26.             code at CompuServe address 76676,2041.
  27.  
  28. ==========================================================================*)
  29. {$M 16000 , 0, 16000}
  30. PROGRAM CleanUp;
  31.  
  32. USES
  33.    Crt, Printer, Dos, DosVer, ObjDD, ObjList, TypCds, ObjCds,
  34.    HexWrite, ObjDpb;
  35.  
  36. TYPE
  37.    DrvPtr     = ^DrvPtrRec;
  38.    DrvPtrRec  = RECORD
  39.                    DrvLet  : Char;
  40.                    NextDrv : DrvPtr
  41.                 END;
  42.  
  43. VAR
  44.    DrvFnd   : DrvPtr;
  45.  
  46. (**************************************************************************)
  47.  
  48. PROCEDURE Intro;
  49.  
  50. BEGIN
  51.    ClrScr;
  52.    WriteLn;
  53.    WriteLn;
  54.    Write('This program cleans up any installed disks by deleting ');
  55.    WriteLn('*.BAK, *.TMP,');
  56.    Write ('*.$$$, *.SYD and *.OLD files.  It also deletes files ');
  57.    WriteLn('of zero length.');
  58.    WriteLn
  59. END;
  60.  
  61. (**************************************************************************)
  62.  
  63. PROCEDURE GetDrvs (VAR DrvFound : DrvPtr);
  64.  
  65.             {PURPOSE: To discover which drives exist and report
  66.                       Them back to the main program
  67.              INPUT:   Uninit'd pointer structure
  68.              OUTPUT:  Pointer structure containing all valid drives}
  69.  
  70. VAR
  71.    I       : Char;            
  72.    Drive   : String;           
  73.    Test    : File;
  74.    Attr    : Word;
  75.    NewNode : DrvPtr;
  76.    C       : CdsObj;
  77.    D       : DDobj;
  78.    T       : DpbObj;
  79.    N       : Byte;
  80.    Name    : DirStr;
  81.  
  82. BEGIN
  83.    DrvFound := NIL;                        {Initialize pointers}
  84.    NewNode  := NIL;
  85.    Requires(300);
  86.    C.Init(L.GetCurDirArray);
  87.    FOR N := L.GetLastDrive DOWNTO 1 DO
  88.       BEGIN
  89.          I := Chr(N+64);
  90.          IF C.IsSubst(N) THEN
  91.             WriteLn('Drive ', I, ': is SUBST''d -- DRIVE IGNORED')
  92.          ELSE IF C.IsJoin(N) THEN
  93.             WriteLn('Drive ', I, ': is JOINED -- DRIVE IGNORED')
  94.          ELSE IF C.IsNetwork(N) THEN
  95.             WriteLn('Drive ', I, ': is a NETWORK DRIVE -- DRIVE IGNORED')
  96.          ELSE IF  D.IsCDRom THEN
  97.             WriteLn('Drive ', I, ': is CDRom -- DRIVE IGNORED')
  98.          ELSE
  99.             BEGIN
  100.                Drive := I + ':\IO.SYS';          {Create the test string}
  101.                Assign(Test, Drive);
  102.                GetFAttr(Test, Attr);             {Find out if the drive exists}
  103.                IF DosError < 3 THEN              {If it does...}
  104.                   BEGIN
  105.                      New(NewNode);               {...Add it to the list}
  106.                      NewNode^.DrvLet := I;
  107.                      NewNode^.NextDrv := DrvFound;
  108.                      DrvFound := NewNode
  109.                   END
  110.             END
  111.       END
  112. END;
  113.  
  114. (**************************************************************************)
  115.  
  116. PROCEDURE TrimLead (VAR S : ExtStr; C : Char);
  117.  
  118.             {PURPOSE: To trim leading characters from String array
  119.              INPUT:   String Array S, Leading Character to Delete C
  120.              OUTPUT:  Trimmed String array S}
  121.  
  122. VAR
  123.    P  :  Byte;
  124.  
  125. BEGIN
  126.    P := 1;
  127.    WHILE (S[P] = C) AND (P <= LENGTH(S)) DO   {S is loger than P and }
  128.       INC(P);                                 {S[P] = Char, step counter}
  129.    CASE P OF
  130.       0 : S[0] := #0;                         { string was full of C!}
  131.       1 : ;                                   { string not found}
  132.       ELSE
  133.          MOVE(S[P], S[1], SUCC(Length(S) - P));  {Trim Char, move to next }
  134.          DEC(S[0], PRED(P));                     {Reset length of string }
  135.       END;
  136. END;
  137.  
  138. (**************************************************************************)
  139.  
  140. PROCEDURE FindAndDie(FileSpec : String;
  141.                      Attr     : Byte);
  142.  
  143.                {PURPOSE: To recurse through the directory structure,
  144.                          Find the target files, and then delete them
  145.                 INPUT:   The general search string (must be *.* for
  146.                          this procedure to work).  The file attribute
  147.                          that will be looked at (as set, it looks at
  148.                          all files).
  149.                 OUTPUT:  Messages to Screen, Target Files are deleted}
  150.  
  151. VAR
  152.    DirEntry    : SearchRec;                   {Type from DOS Unit}
  153.    DelString,
  154.    FileName,
  155.    ExpFileName,
  156.    WhereIAm    : String;
  157.    FPath       : PathStr;                     {TYPES for }
  158.    FDir        : DirStr;                      {FSplit from }
  159.    FName       : NameStr;                     {DOS }
  160.    FExt        : ExtStr;                      {UNIT }
  161.    DelFile     : File;
  162.    Target      : Boolean;
  163.  
  164. BEGIN
  165.    FindFirst(FileSpec, Attr, DirEntry);       {Get the first file}
  166.    If DosError > 0 THEN Exit;                 {Any problems, LEAVE}
  167.    WHILE DosError <> 18 DO                   {Still have files to go?}
  168.       BEGIN
  169.          Target := False;
  170.          FileName := DirEntry.Name;
  171.          ExpFileName := FExpand(DirEntry.Name);     {Set it up}
  172.          FSplit(ExpFileName, FDir, FName, FExt);
  173.          TrimLead(Fext , '.');
  174.          IF ((DirEntry.Attr AND $10) = $10) AND  { See if it is a directory}
  175.             NOT ((DirEntry.Name = '.') OR (DirEntry.Name = '..')) THEN
  176.                BEGIN
  177.                   GetDir(0, WhereIAm);     {If so, save and go there}
  178.                   ChDir(DirEntry.Name);
  179.                   FindAndDie(FileSpec, Attr);    {Recurse procedure}
  180.                   ChDir(WhereIAm)                {Come Home}
  181.                END
  182.          ELSE
  183.             IF ((FExt = '$$$') or (FExt = 'BAK') OR
  184.                 (FExt = 'SYD') OR (FExt = 'OLD') OR
  185.                 (FExt = 'TMP') OR
  186.                ((DirEntry.Size = 0) AND NOT
  187.                (((DirEntry.Attr AND $08) = $08) OR
  188.                (DirEntry.Name = '.') OR (DirEntry.Name = '..'))))
  189.                THEN
  190.                   BEGIN
  191.                      IF ((FExt = '$$$') or (FExt = 'BAK') OR
  192.                          (FExt = 'SYD') OR (FExt = 'OLD') OR
  193.                          (FExt = 'TMP')) THEN
  194.                         Target := True;
  195.                      IF Target THEN
  196.                         Write('Target File:      ')
  197.                      ELSE
  198.                         Write('Zero Length File: ');
  199.                      DelString := '/C DEL '+ DirEntry.Name;    {Set up and...}
  200.                      Assign(DelFile, ExpFileName);
  201.                      SetFAttr(DelFile, Archive);
  202.                      SwapVectors;
  203.                      Exec ('c:\dos\command.com ', DelString);  {Get rid of it}
  204.                      SwapVectors;
  205.                      WriteLn(ExpFileName); {Tell the world}
  206.                   END;
  207.          FindNext(DirEntry)                    {Get next file and loop}
  208.       END
  209. END;
  210.  
  211. (**************************************************************************)
  212.  
  213. PROCEDURE KillFiles(VAR DrivesFnd : DrvPtr);
  214.  
  215.               {PURPOSE: To control default drive setting, and set up
  216.                         for procedure call to FindAndDie.
  217.                INPUT:   Pointer structure of all available drives
  218.                OUTPUT:  Passes setup to procedure, set user to original
  219.                         directory and drive. }
  220.  
  221. VAR
  222.    Home,
  223.    DirRoot,
  224.    FileSpec : String;
  225.    Attr     : Byte;
  226.    Current  : DrvPtr;
  227.  
  228. BEGIN
  229.    GetDir(0,Home);                            {Save the home position}
  230.    FileSpec := '*.*';
  231.    Attr     := $3F;
  232.    WriteLn('REASON            FILENAME AND PATH');
  233.    WriteLn;
  234.    REPEAT
  235.       Current := DrivesFnd;                   {Run through the drives}
  236.       DirRoot := DrivesFnd^.DrvLet + ':\';
  237.       ChDir(DirRoot);
  238.       FindAndDie(FileSpec, Attr);  {Find and kill the target files}
  239.       DrivesFnd := DrivesFnd^.NextDrv;
  240.       Dispose(Current)                      {Get rid of current pointer}
  241.    UNTIL DrivesFnd = NIL;                   {Go to home position}
  242.    ChDir(Home)
  243. END;
  244.  
  245. (*========================================================================*)
  246. BEGIN {Main Program}
  247.    Intro;
  248.    GetDrvs(DrvFnd);
  249.    WriteLn;
  250.    KillFiles(DrvFnd)
  251. END.
  252.